home *** CD-ROM | disk | FTP | other *** search
/ The Business Master (4th Edition) / The Business Master - 4th Edition.iso / files / utilhive / lharc114 / lzip13.bas < prev    next >
Encoding:
BASIC Source File  |  1989-03-11  |  14.7 KB  |  400 lines
  1. ' $title:'LZIP - Attempt to make the Littlest ZIP file' $pagesize:74 $linesize:132
  2. ' by S. David Klein, version 1.3, 3/11/89
  3. ' derived from LARC version 1.6 by Vernon D. Buerg, used with permission
  4. '
  5. ' Purpose:
  6. '       - make the smallest ZIP files possible
  7. '       - learn how the ADVBAS subroutines work
  8. '       - evaluate compression efficiency of ZIP options
  9. '       - convert all ARC files to the smallest ZIP files possible
  10. '
  11. ' Usage:
  12. '       LZIP13 d:[\path\]filespec [d:\outpath] [/R] [/F]
  13. '
  14. '       The input file specification is required and specifies the
  15. '       location of ZIP files to be processed. The path name is optional.
  16. '
  17. '       You MUST not have the input dir as the current dir. The current
  18. '       drive (and directory) is used for temporary work space. Each
  19. '       ZIP file is extracted to the current directory.
  20. '
  21. '       If the processed ZIP file is smaller, the original ZIP file
  22. '       is replaced. The file's date and time are preserved.
  23. '
  24. '       You must have ARCE, PKZIP and PKUNZIP accessible from the DOS path;
  25. '       PKZIP must be version 0.92 which supports the -ex option
  26. '       if you have changed the names of the .EXE files, make the necessary
  27. '       changes in this source and compile/link (QB 4.5):
  28. '                       BC LZIP13 /D/E/O;
  29. '                       LINK LZIP13,,,ADVBAS;
  30. '
  31. ' Options:
  32. '       /R specifies that a summary report is produced in the file LZIP.RPT.
  33. '       /F specifies that the first ZIP created will replace the original file;
  34. '          this is useful when adding a comment or replacing all ARC files.
  35. '
  36. ' ==========================================================================
  37. ' Definitions
  38.  
  39.         defint a-z : maxfiles = 512
  40.  
  41.         dim arc$(maxfiles)              ' filenames and stats for later
  42.         dim method$(3)                  ' up to three methods used
  43.         dim savings(3)                  ' total bytes saved per method
  44.  
  45.         version$="LZIP Version 1.3"     ' some internal signs
  46.         author$="by S. David Klein"
  47.  
  48.         false = 0 : true = not false
  49.         cluster = 512                   ' target disk cluster size
  50.  
  51.          ' $dynamic
  52.  
  53.         dim before!(maxfiles)           ' original file sizes
  54.         dim after!(maxfiles,3)          ' sizes after each method
  55.         dim stamp(maxfiles,6)           ' file mo,dy,yr;hr,min,sec
  56.          ' $static
  57.  
  58.         def fneat$(x!)                  ' neaten number displays
  59.            fneat$ = right$(space$(8)+str$(x!),8)
  60.         end def
  61.  
  62.         def fn ltrim$(x$)               ' trim leading blanks
  63.            while left$(x$,1)=" "
  64.              x$=mid$(x$,2)
  65.            wend
  66.            fn ltrim$ = x$
  67.         end def
  68.  
  69.         def fn rtrim$(x$)               ' trim trailing blanks
  70.            while right$(x$,1)=" "
  71.              x$=left$(x$,len(x$)-1)
  72.            wend
  73.            fn rtrim$ = x$
  74.         end def
  75.  
  76.         def fn trim$(x$)                ' trim left and right blanks
  77.            fn trim$ = fn rtrim$(fn ltrim$(x$))
  78.         end def
  79.  
  80.         def fn switch (x$)              ' process option switches
  81.            if instr(parm$,x$) _
  82.              then fn switch = true : _
  83.                   mid$(parm$,instr(parm$,x$),2)="  " _
  84.              else fn switch = false
  85.         end def
  86.  
  87. ' $page $subtitle: 'Initialization'
  88. ' =============================================================================
  89.  
  90. initialize:
  91.         on error goto err.traps
  92.  
  93.         call getdosv(majorv,minorv)     ' check dos version
  94.          if majorv<3 then print "Incorrect DOS version." : end
  95.  
  96.         parm$=command$                  ' command parameters and options
  97.         swr = fn switch ("/R")          ' produce LZIP.RPT
  98.         swf = fn switch ("/F")          ' force ZIP replacement
  99.  
  100.         swa=true                        ' use the -aex option of PKZIP 0.92
  101.  
  102.         method=1                        ' index to method name
  103.         method$(method)="A"
  104.  
  105.                                         ' get input file d:\path\filename
  106.         if instr(parm$," ") _           ' and output drive:\path
  107.           then infile$ = fn trim$(left$(parm$,instr(parm$," ")-1)) : _
  108.                outpath$ = fn trim$(mid$(parm$,instr(parm$," ")+1)) _
  109.           else infile$ = fn trim$(parm$) : _
  110.                outpath$ = ""
  111.  
  112.         if infile$="" then print "Input filespec missing!" : end
  113.  
  114.         if instr(infile$,".")=0 then infile$=infile$+".ZIP"
  115.  
  116.  
  117.         in.drive$=" "                   ' get drive letter of original files
  118.          if mid$(infile$,2,1) = ":" _
  119.            then in.drive$=left$(infile$,1) : _
  120.                 infile$=mid$(infile$,3) _
  121.            else print "You must supply the input drive letter!" : _
  122.                 end
  123.  
  124.         call drvspace (in.drive$,a,b,c) ' initial free space on source drive
  125.          before.space! = csng(a)*csng(b)*csng(c)
  126.          cluster = a * 512              ' target disk cluster size
  127.  
  128.         inpath$=""                      ' get input drive and path names
  129.  
  130.         for i=len(infile$) to 1 step -1    'altered this section 12/26/88
  131.          if mid$(infile$,i,1)="\" then     'to work with QB 4.5, since the
  132.                inpath$=left$(infile$,i)    'ELSE NEXT structure seemed not
  133.                infile$=mid$(infile$,i+1)   'to work.  This seems to do the
  134.          end if                            'job.
  135.         next
  136.  
  137.         temp.drive$=" "                 ' make sure different drives\paths
  138.          call getdrv(temp.drive$)       ' for temp, input, and output
  139.  
  140.         temp.path$=string$(64,0)        ' temporary d:\path
  141.          call getsub (temp.path$,tlen)
  142.          temp.path$="\"+left$(temp.path$,tlen)+"\"
  143.          temp.file$=temp.drive$+":"+left$(temp.path$,len(temp.path$)-1)
  144.  
  145.         call findfirstf ("*.*"+chr$(0),0,retcd)   ' insure temp is empty
  146.  
  147.         if (temp.drive$ = in.drive$ and temp.path$=inpath$) _
  148.              or outpath$ = temp.file$ _
  149.              or retcd = 0 _
  150.                then
  151.           print "Input path:  ";in.drive$+":"+inpath$
  152.           print "Output path: ";outpath$
  153.           print "Temp path:   ";temp.file$
  154.           print
  155.           print "You must use a different d:\path for the original input files,"
  156.           print "and the output destination drive and path;  other than the"
  157.           print "current directory used for the temporary work files!"
  158.           print "The temporary directory must be empty."
  159.           end
  160.         end if
  161.  
  162. ' $page $subtitle: 'Mainline'
  163. ' =============================================================================
  164.  
  165. mainline:
  166.         attr = 0 : retcd=0                      ' get first file name
  167.         arcname$=in.drive$+":"+inpath$+infile$  ' from original filespec
  168.  
  169.         call findfirstf (arcname$+chr$(0),attr,retcd)
  170.          if retcd then
  171.            print "No matching files found for ";arcname$
  172.            end
  173.          end if
  174.  
  175. ' Build table of files to process
  176.  
  177. get.file:                                       ' extract next file name
  178.         infile$=space$(12)
  179.          call getnamef (infile$,flen)
  180.          if flen <0 _
  181.            then print "GETNAMEF logical error." : end _
  182.            else infile$=left$(infile$,flen)
  183.  
  184.          if numfiles < maxfiles _               ' save data for report
  185.            then numfiles=numfiles+1
  186.  
  187.          call getdatef(month,day,year)          ' preserve datestamp
  188.           stamp(numfiles,1)=month
  189.           stamp(numfiles,2)=day
  190.           stamp(numfiles,3)=year
  191.          call gettimef(hour,minute,second)
  192.           stamp(numfiles,4)=hour
  193.           stamp(numfiles,5)=minute
  194.           stamp(numfiles,6)=second
  195.  
  196.          call getsizef(lo,hi)                   ' original file size
  197.           lo!=csng(lo)
  198.           if lo<0 then lo!=lo!+65536!
  199.           insize!=lo!+csng(hi)*65536!
  200.  
  201.          arc$(numfiles)=infile$
  202.          before!(numfiles)=insize!
  203.          for method=1 to 3
  204.           after!(numfiles,method)=insize!
  205.          next method
  206.  
  207.         call findnextf (retcd)                  ' next file to process
  208.         if retcd=0 then goto get.file
  209.  
  210. ' $page $subtitle:'Invoke ARC processors for each archive file'
  211. ' ----------------------------------------------------------------
  212.  
  213. process:
  214. 100     for filenum=1 to numfiles
  215.          infile$=arc$(filenum)                  ' original file name
  216.          insize!=before!(filenum)               '  and file size
  217.          before!=insize!
  218.          arcname$=in.drive$+":"+inpath$+infile$    ' complete original filespec
  219.  
  220.          outfile$=infile$                       ' form target file name
  221.          if instr(infile$,".ARC") _
  222.            then mid$(outfile$,instr(infile$,".ARC"),4)=".ZIP"
  223.  
  224.  
  225. 120     method = 0                              ' index for method used to ZIP
  226.  
  227.        'if insize!<cluster then                 ' skip small files?
  228.        '  for s=1 to 3                          ' commented out to force all
  229.        '   after!(filenum,s)=insize!            ' files to be processed
  230.        '  next
  231.        '  if outpath$ = "" _                    ' unless copying all ZIP files
  232.        '    then goto next.file
  233.        'end if
  234.  
  235.         replaced=copies                         ' times file has been copied
  236.  
  237.         if instr(arcname$,".ARC") _             ' extract the file
  238.           then cmd$="arce "+arcname$ _
  239.           else cmd$="pkunzip "+arcname$
  240.  
  241.          cls : color 15,0 : print cmd$ : color 7,0
  242.          shell cmd$
  243.  
  244.  
  245.         if swa then
  246.          cmd$="pkzip -aex "+outfile$+" *.*"       ' make the smallest ZIP
  247.  
  248. '                                                  some variations on the theme-
  249. '                                             to add a comment, use this example
  250. 'cmd$="pkzip -azex "+outfile$+" *.* < comment.txt              where comment.txt
  251. '                                               contains the comment to be added
  252.  
  253.          cls : color 15,0 : print cmd$ : color 7,0
  254.          shell cmd$
  255.          gosub evaluate
  256.         end if
  257.  
  258.         if okay then kill "*.*"                 ' rid extracted files
  259.  
  260.         if outpath$<>"" and replaced=copies then   ' did not copy it yet?
  261.            cmd$ = "copy "+arcname$+" "+outpath$    ' do it now
  262.            cls : color 15,0 : print cmd$ : color 7,0
  263.            shell cmd$
  264.            copies = copies + 1
  265.         end if
  266.  
  267.         if instr(arcname$,".ARC") and replaced<>copies and outpath$="" _
  268.           then kill arcname$            ' delete original ARC file
  269.  
  270. next.file:
  271.         next filenum
  272.  
  273. ' $page $subtitle: 'Display file statistics'
  274. ' =============================================================================
  275.  
  276. report:
  277. 200     if swr _
  278.           then rptname$="lzip.rpt" _
  279.           else rptname$="scrn:"
  280.            open rptname$ for output as #1
  281.  
  282.         beep                                    ' wake em up
  283.  
  284.         if okay =0 _                            ' something broke
  285.           then locate 24,1 : _
  286.                print "Aborted due to Error or ESC keyin!" : _
  287.                print : _
  288.                gosub newpage _
  289.           else gosub heading
  290.  
  291.         for i=1 to numfiles
  292.          if swr=0 and csrlin>22 then gosub newpage
  293.          print #1,arc$(i);tab(15); fneat$(before!(i));
  294.          for s=1 to method
  295.           after=int( (after!(i,s)+cluster-1)/cluster)
  296.           before=int( (before!(i)+cluster-1)/cluster)
  297.           savings = after-before
  298.           savings(s)=savings(s)+savings
  299.           print #1,fneat$(after!(i,s)); fneat$(csng(savings)*cluster);
  300.          next s
  301.          print #1,
  302.         next
  303.  
  304.         if swr=0 and csrlin>12 then gosub newpage
  305.          print #1,copies;"file(s) replaced";    ' Sum of savings by method
  306.          print #1,tab(30);" ";
  307.         for s=1 to method
  308.          print #1,fneat$(csng(savings(s))*cluster);"        ";
  309.         next
  310.         print #1,
  311.  
  312.         call drvspace (in.drive$,a,b,c)         ' get disk space saving
  313.          after.space! = csng(a)*csng(b)*csng(c)
  314.  
  315.          print #1,
  316.          print #1," Free disk space: "
  317.          print #1,"           before ";
  318.          print #1,using "##,###,###";before.space!
  319.          print #1,"           after  ";
  320.          print #1,using "##,###,###";after.space!
  321.          print #1,"           saved  ";after.space! - before.space!;"bytes"
  322.  
  323.         close #1                                ' all done
  324.  
  325.  
  326.         if swr then
  327.          open rptname$ for input as #1          ' display the report
  328.          while not eof (1)                      '  in addition to writing it to
  329.           line input #1,a$                      '   the file to LZIP.RPT
  330.           print a$
  331.          wend
  332.          close #1
  333.         end if
  334.  
  335.         end
  336.  
  337. newpage:
  338.         line input "Press ENTER to continue:";a$
  339. heading:
  340.         cls                                     ' pretty fancy, eh?
  341.         print #1,version$;" - Processing ";command$
  342.          print #1,
  343.          print #1,"Filename";tab(15);"  before";
  344.          for s=1 to method
  345.           print #1,"  after";method$(s);"    diff";
  346.          next
  347.         print #1,
  348.         locate ,1
  349.         return
  350.  
  351. ' $page $subtitle: 'Evaluate results of re-ZIPing the files'
  352. ' ---------------------------------------------------------
  353.  
  354. evaluate:
  355.         okay = 0                                ' indicates success or not
  356.         if inkey$ = chr$(27) then return report ' aborted by ESCape key
  357.         okay = 1
  358.         method = method + 1
  359.  
  360. 300     open outfile$ for input as #2           ' get new file size
  361.          outsize!=lof(2)
  362.          close #2
  363.  
  364. 310     after!(filenum,method)=outsize!
  365.  
  366.         'after=int( (outsize!+cluster-1)/cluster) ' compute clusters saved
  367.         'before=int( (before!+cluster-1)/cluster)
  368.         savings! = outsize! - before!    ' bytes (was clusters) saved
  369. 400     if savings! <0 or (outpath$<>"" and method=1) or swf then
  370.  
  371.          call setftd(outfile$+chr$(0),stamp(filenum,1),stamp(filenum,2), _
  372.                      stamp(filenum,3),stamp(filenum,4),stamp(filenum,5), _
  373.                      stamp(filenum,6) )         ' preserve date stamp
  374.  
  375.          if outpath$="" _               ' overlay original or to another subdir
  376.            then cmd$= "copy "+outfile$+" "+in.drive$+":"+inpath$+outfile$ _
  377.            else cmd$= "copy "+outfile$+" "+outpath$
  378.  
  379.          cls : color 15,0 : print cmd$ : color 7,0
  380.          shell cmd$
  381.          before!=outsize!               ' new original file size
  382.          copies=copies+1
  383.  
  384.         end if
  385.  
  386. 410     kill outfile$                   ' rid the temporary file
  387. copy.done:
  388.         return
  389.  
  390. copy.failed:
  391.         okay = 0
  392.         return report 'next.file                ' file not found, not created, etc.
  393.  
  394. err.traps:
  395.         if erl=100 then print arcname$;" not found"
  396.         if erl=410 then resume copy.done        ' short file only copied
  397.         if erl=300 then resume copy.failed      ' no ZIP created
  398.         print "Error";err;"at line";erl
  399.         end
  400.